home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / manchester / 4.1 / PanningWrapper.st < prev    next >
Text File  |  1993-07-24  |  4KB  |  171 lines

  1. "    NAME        panning-wrapper
  2.     AUTHOR        bhoran@cs.man.ac.uk (Bernard Horan) and miw@cs.man.ac.uk (Mario Wolczko)
  3.     FUNCTION    a wrapper for panning over large two-way scrollable area
  4.     ST-VERSION    4.1
  5.     PREREQUISITES    
  6.     CONFLICTS     
  7.     DISTRIBUTION    world
  8.     VERSION        2.1
  9.     DATE        10 Nov 1992
  10. SUMMARY This goodie provides a wrapper class and controller that can be
  11. used in a view to pan over a larger view.  
  12.  
  13. Cursor>fourWay is the cursor displayed when panning.
  14.  
  15. Mario Wolczko
  16.  
  17. Dept. of Computer Science   Internet:      mario@cs.man.ac.uk
  18. The University              uucp:          uknet!!man.cs!!mario
  19. Manchester M13 9PL          JANET:         mario@uk.ac.man.cs
  20. U.K.                        Tel: +44-61-275 6146  (FAX: 6236)
  21. ______the mushroom project___________________________________
  22.  
  23. "
  24. 'From Objectworks\Smalltalk(R), Release 4.1 of 15 April 1992 on 10 November 1992 at 12:36:37 am'!
  25.  
  26. Controller subclass: #PanningController
  27.     instanceVariableNames: ''
  28.     classVariableNames: ''
  29.     poolDictionaries: ''
  30.     category: 'Interface-Support'!
  31. PanningController comment:
  32. 'PanningController is used by a  PanningWrapper, so it can be panned/scrolled in any direction using the <select> button.
  33.  
  34. Modified from Mario Wolczko''s earlier R4.0 version for R4.1.
  35. Bernard Horan, 16 October 1992'!
  36.  
  37.  
  38. !PanningController methodsFor: 'control defaults'!
  39.  
  40. controlActivity
  41.     | last pt oldGrid |
  42.     last := self sensor cursorPoint.
  43.     oldGrid := view scrollGrid.
  44.     view scrollGrid: 1@1.
  45.     Cursor fourWay showWhile:
  46.         [[self sensor redButtonPressed] whileTrue:
  47.             [self poll.
  48.             pt := self sensor cursorPoint.
  49.             pt ~= last
  50.                 ifTrue: [view scrollBy: last - pt. last := pt]]].
  51.     view scrollGrid: oldGrid.!
  52.  
  53. isControlActive
  54.     ^self sensor redButtonPressed "and: [self viewHasCursor]"! !
  55.  
  56. 'From Objectworks\Smalltalk(R), Release 4.1 of 15 April 1992 on 10 November 1992 at 12:36:40 am'!
  57.  
  58. ScrollWrapper subclass: #PanningWrapper
  59.     instanceVariableNames: 'controller '
  60.     classVariableNames: ''
  61.     poolDictionaries: ''
  62.     category: 'Interface-Support'!
  63. PanningWrapper comment:
  64. 'A PanningWrapper is like a ScrollWrapper, but also allows panning, when that component does not want control.
  65.  
  66. My controller is usually a PanningController.
  67.  
  68. Adapted from Mario Wolczko''s earlier R4.0 version.
  69. Bernard Horan, 16 October 1992'!
  70.  
  71.  
  72. !PanningWrapper methodsFor: 'initialize-release'!
  73.  
  74. initialize
  75.     super initialize.
  76.     controller := PanningController new.
  77.     controller view: self! !
  78.  
  79. !PanningWrapper methodsFor: 'control defaults'!
  80.  
  81. myControllerWantingControl
  82.     ^controller isControlWanted ifTrue: [controller] ifFalse: [nil]!
  83.  
  84. objectWantingControl
  85.     "Check if a subview wants control; if not, check my controller."
  86.     | c |
  87.     c := super objectWantingControl.
  88.     c isNil ifTrue: [c := self myControllerWantingControl].
  89.     ^c! !
  90.  
  91. !PanningWrapper methodsFor: 'accessing'!
  92.  
  93. controller: c
  94.     controller := c!
  95.  
  96. getController
  97.     ^controller! !
  98.  
  99. !PanningWrapper methodsFor: 'scrolling'!
  100.  
  101. scrollBy: aPoint
  102.     self scrollHorizontallyBy: aPoint x.
  103.     self scrollVerticallyBy: aPoint y.!
  104.  
  105. scrollGrid
  106.     ^origin grid!
  107.  
  108. scrollGrid: aPoint
  109.     ^origin grid: aPoint! !
  110.  
  111. !PanningWrapper methodsFor: 'private'!
  112.  
  113. setComponent: aVisualComponent
  114.     "Set the receiver's component to be aVisualComponent.  If the receiver is open, propagate damage.
  115.     This is so wrappers can have dynamically changing components."
  116.  
  117.     super setComponent: aVisualComponent.
  118.     origin grid: 4@4! !
  119.  
  120. Cursor addClassVarName: 'FourWay'!
  121.  
  122. !Cursor class methodsFor: 'private-constant initialization'!
  123.  
  124. initFourWay
  125.     "Cursor initFourWay"
  126.     FourWay := 
  127.          (self 
  128.             imageArray: #(
  129.         2r0000000100000000
  130.         2r0000001110000000
  131.         2r0000011111000000
  132.         2r0000111111100000
  133.         2r0001001110010000
  134.         2r0011001110011000
  135.         2r0111111111111100
  136.         2r1111111111111110
  137.         2r0111111111111100
  138.         2r0011001110011000
  139.         2r0001001110010000
  140.         2r0000111111100000
  141.         2r0000011111000000
  142.         2r0000001110000000
  143.         2r0000000100000000
  144.         2r0000000000000000)
  145.             maskArray: #(
  146.         2r0000000100000000
  147.         2r0000001110000000
  148.         2r0000011111000000
  149.         2r0000111111100000
  150.         2r0001001110010000
  151.         2r0011001110011000
  152.         2r0111111111111100
  153.         2r1111111111111110
  154.         2r0111111111111100
  155.         2r0011001110011000
  156.         2r0001001110010000
  157.         2r0000111111100000
  158.         2r0000011111000000
  159.         2r0000001110000000
  160.         2r0000000100000000
  161.         2r0000000000000000)
  162.             hotSpot: 8@8 name: 'four way')! !
  163.  
  164. !Cursor class methodsFor: 'constants'!
  165.  
  166. fourWay
  167.     ^FourWay! !
  168.  
  169. Cursor initFourWay!
  170.  
  171.